Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/Apple II/Essentials/Dynamo 4.2 for GSBug 1.5b10/app.builder/build.a

Text File | 1990-09-21 | 17.0 KB | 927 lines | [TEXT/MPS ]

****************************************************************
*                            *
* buildapp.system                        *
*                            *
* Apple II 8-bit application builder and launcher.        *
* Copyright (C) 1990 Apple Computer.            *
* Version 4.2                        *
*                            *
* Written by Eric Soldan, Apple II DTS            *
*                            *
****************************************************************

        include    ':dynamo.includes:sys.equ'
        include    ':dynamo.includes:rt.h'
        include    ':dynamo.includes:rt.macros'

        include    'app.config'
        include    'm16.memory'

*********************************************

buildText    equ    $1600        ;Script file for building application.

fileName        equ    $1E00        ;filestr starts at $1E01.  Runtime
                    ;strings aren't pascal-type.  There
                    ;is a table called strlens that holds
                    ;the lengths.  There is another table
                    ;called maxstrlens that defines how
                    ;big each string can get.
                    ;To make a pascal string for ProDOS,
                    ;the characters for the file name
                    ;are placed in filestr.  Then the
                    ;string length byte is copied to
                    ;fileName, just in front of filestr.
                    ;Now we have a regular pascal string
                    ;for ProDOS.
btFileName    equ    $1E80        ;This is the boot time file name.  If
                    ;the user of BUILDAPP.SYSTEM wants to
                    ;have his text in a file other than
                    ;BUILDAPP.TEXT, or if the script file
                    ;is in another directory, then he can
                    ;place the pathname of the file into
                    ;BUILDAPP.SYSTEM, starting at byte $2006.
                    ;This is the standard way for launched
                    ;programs to be given a pathname.  The
                    ;default pathname in this location
                    ;is BUILDAPP.TEXT. btpathstr starts at
                    ;$1E81.  This string works like filestr,
                    ;in reverse.  The pascal string is first
                    ;copied into btFileName, and then the
                    ;length byte is stored in the strlens
                    ;table.  The reason for copying the
                    ;string from $2006 is because this area
                    ;will be written over, and if the user
                    ;wants to re-run the program due to an
                    ;error, this string would have been lost.

*********************************************

MLI        equ    $BF00        ;Various equates for ProDOS.
paramCount    equ    $00

CREATE        equ    $C0
create_pathname    equ    $01
create_access    equ    $03
create_filetype    equ    $04
create_auxtype    equ    $05
create_strgtype    equ    $07
create_createdate    equ    $08
create_createtime    equ    $0A

OPEN        equ    $C8
open_pathname    equ    $01
open_iobuffer    equ    $03
open_refnum    equ    $05

READ        equ    $CA
read_refnum    equ    $01
read_databuffer    equ    $02
read_reqcount    equ    $04
read_transcount    equ    $06

WRITE        equ    $CB
write_refnum    equ    $01
write_databuffer    equ    $02
write_reqcount    equ    $04
write_transcount    equ     $06

SETEOF        equ    $D0
setEOF_refnum    equ    $01
setEOF_EOF    equ    $02

SETFILEINFO    equ    $C3
setInfo_pathname    equ    $01
setInfo_access    equ    $03
setInfo_filetype    equ    $04
setInfo_auxtype    equ    $05
setInfo_nullfield    equ    $07
setInfo_moddate    equ    $0A
setInfo_modtime    equ    $0C

GETFILEINFO    equ    $C4
getInfo_pathname    equ    $01
getInfo_access    equ    $03
getInfo_filetype    equ    $04
getInfo_auxtype    equ    $05
getInfo_strgtype    equ    $07
getInfo_blksused    equ    $08
getInfo_moddate    equ    $0A
getInfo_modtime    equ    $0C
getInfo_crdate    equ    $0E
getInfo_crtime    equ    $10

CLOSE        equ    $CC
close_refnum    equ    $01

QUIT        equ    $65

*********************************************

numstrings    equ    5

bffrstr        equ    0
maxbffrstr    equ    127
bffrstrloc    equ    $1D01

tempstr        equ    1
maxtempstr    equ    127
tempstrloc    equ    $1D81

filestr        equ    2
maxfilestr    equ    127
filestrloc    equ    $1E01

btpathstr    equ    3
maxbtpathstr    equ    64
btpathstrloc    equ    $1E81

pathstr        equ    4
maxpathstr    equ    127
pathstrloc    equ    $2007

*********************************************

        export    intspace
intspace        PROC
        ds.b    256
        endp

******************

        export    strspace
strspace        PROC
        export    strlens, maxstrlens, strlocs
strlens        ds.b    numstrings
maxstrlens    dc.b    maxbffrstr, maxtempstr, maxfilestr, maxbtpathstr, maxpathstr
strlocs        dc.w    bffrstrloc, tempstrloc, filestrloc, btpathstrloc, pathstrloc
        endp

******************

main        PROC

        lda    #0        ;Clear the variable space.
        tax            ;This application does not
@clearvars    sta    intspace,x    ;need to variables to be
        inx            ;pre-cleared.
        bne    @clearvars

@moveDisp    lda    $4000,x        ;Move the dispatcher to $2000.
        sta    $2000,x        ;This is so we can use buildapp.system
        lda    $4100,x        ;to build buildapp.system.
        sta    $2100,x
        inx
        bne    @moveDisp

        ldx    #64        ;Get boot path from system
@getPath        lda    $2006,x        ;file and place it in btpathstr.
        sta    btFileName,x
        dex
        bpl    @getPath
        lda    btFileName
        sta    strlens+btpathstr

******************

restart        lda #0            ;This string is the last read from the
        sta    strlens+bffrstr    ;buildapp.text file.  Init it to NULL.

        jsr    $C300        ;Initialize 80-col screen.
        _writecr
        jsr    home

        _rtreset
        _hibitchrs

        _write    'IIe Application builder  v4.2',13,\
            'Copyright (C) 1990 by Apple Computer.',13,13,\
            'Building application, please wait.',13,13,13

        _strcpy    filestr,btpathstr
                    ;Put file name of load build text
                    ;in filestr.  All proDOS operations
                    ;that need a file name expect it in
                    ;filestr in this application.

        jsr    loadFile
        dc.w    buildText
        dc.w    $FFFF
        bcc    @a
        _write    13,13,'Could not load '
        _prstr    filestr
        _write    '.'
        jmp    abort


@a        lda    readBlock+read_transcount
        sta    ptr
        lda    readBlock+read_transcount+1
        clc
        adc    #>buildText    ;Make sure that the build text
        sta    ptr+1        ;ends with a c/r, or else _readstr
        lda    #13        ;may get real unhappy.
        ldy    #0
        sta    (ptr),y
        iny            ;If a string of 1 char (a 255) is read,
        iny            ;then the end of the file was read
        sta    (ptr),y        ;prematurely, and an error will be issued.
        dey
        lda    #255
        sta    (ptr),y


        _restore #buildText    ;Point readData at buildText.
        _readend #13        ;_readstr will stop at a c/r.

        _set    buildaddr,*$2006+65
* The dispatcher has the ending location stored in this address.  Point after
* dispatcher.  We don't have to load the dispatcher, since it is already at
* $2000.  (It was used to launch this application.)

        _var    pathstr        ;pathstr location is $2007, so text
        jsr    getstr        ;is read directly into dispatcher.
        bcc    @ok1
        jsr    EOFMessage
        _write    'pathname.'
        jmp    abort


@ok1        lda    strlens+pathstr
        sta    $2006        ;Make a pascal string out of it.

******************

mainloop        _var    mode
        jsr    getint
        bcc    @ok2
        jsr    EOFMessage
        _write    'bank selection bit setting.'
        jmp    abort

@ok2        lda    intspace+mode+1    ;Make sure only bit 7 of hi-byte is
        asl    a        ;on, if any.  This bit indicates that
        bne    @bad2        ;GSBUG should be prepped for 8-bit.
        lda    intspace+mode
        and    #$20        ;Make sure bit 5 is off.
        beq    @ok2a
@bad2        _write    'Bad bank selection bit setting ('
        _var    mode
        lda    decimalint
        bne    @bad2a
        _write    '$'
        _vhexout
        jmp    @bad2b
@bad2a        _vdecout
@bad2b        _write    ').'
        jmp    abort

@ok2a        _var    address
        jsr    getint
        bcc    @ok3
        jsr    EOFMessage
        lda    intspace+mode
        bpl    @a
        _write    'starting'
        jmp    @b
@a        _write    'segment'
@b        _write    ' address.'
        jmp    abort

@ok3        lda    intspace+mode+1    ;Check GSBUG 8-bit prep bit.
        beq    @c
        jmp    prepGSBUG    ;Prep GSBUG to work in 8-bit.

@c        lda    intspace+mode    ;Bit 7 of mode byte indicates no
        bpl    @d        ;more segments.  Following field
        jmp    startaddr    ;is launch address.

@d        _var    filestr
        jsr    getstr
        bcc    @ok4
        jsr    EOFMessage
        _write    'filename.'
        jmp    abort

@ok4        _write 'Loading '
        _prstr filestr
        _write '...',13

        lda    intspace+buildaddr ;Make space for 5 bytes that
        clc            ;will be filled in later.
        adc    #5
        sta    @addr
        lda    intspace+buildaddr+1
        adc    #0
        sta    @addr+1
        jsr    loadFile
@addr        dc.w    $2000
        dc.w    $FFFF
        bcc    @e
        jmp    noLoad

@e        lda    intspace+buildaddr ;Put the segment relocation
        sta    ptr        ;information in front of segment.
        lda    intspace+buildaddr+1
        sta    ptr+1
        ldy    #0
        lda    intspace+mode
        sta    (ptr),y
        iny
        lda    intspace+address
        sta    (ptr),y
        iny
        lda    intspace+address+1
        sta    (ptr),y
        iny
        lda    readBlock+read_transcount
        sta    (ptr),y
        iny
        lda    readBlock+read_transcount+1
        sta    (ptr),y

        lda    ptr        ;Point past segment.
        clc
        adc    #5
        bcc    @f
        inc    ptr+1
        clc
@f        adc    readBlock+read_transcount
        sta    intspace+buildaddr
        lda    ptr+1
        adc    readBlock+read_transcount+1
        sta    intspace+buildaddr+1

        jmp    mainloop        ;Load another segment.

startaddr    _write    13,'Starting address is '
        _var    tempstr
        jsr    getstr
        bcc    @ok5
        jsr    crEOFMessage
        _write    'address display format.'
        jmp    abort

@ok5        lda    tempstrloc
        _var    address
        cmp    #'$'
        beq    @hex
        _vdecout
        jmp    @a
@hex        _rtcout
        _vhexout
@a        _writecr

        lda    intspace+buildaddr ;Store the launch information.
        sta    ptr
        lda    intspace+buildaddr+1
        sta    ptr+1
        ldy    #0
        lda    intspace+mode
        sta    (ptr),y
        iny
        lda    intspace+address
        sta    (ptr),y
        iny
        lda    intspace+address+1
        sta    (ptr),y

        lda    ptr        ;Calculate application size.
        sec
        sbc    #<$2000-3
        sta    intspace+applen
        lda    ptr+1
        sbc    #>$2000-3
        sta    intspace+applen+1

        _write    13,'Application length is '
        _var    tempstr
        jsr    getstr
        bcc    @ok6
        jsr    crEOFMessage
        _write    'length display format.'
        jmp    abort

@ok6        lda    tempstrloc
        _var    applen
        cmp    #'$'
        beq @hex0
        _vdecout
        jmp @a0
@hex0        _rtcout
        _vhexout

@a0        _write    13,13,'Save application? (Y,N,Q) '
        _var    tempstr        ;See if we have a script value for
        jsr    getstr        ;Y,N,Q.
        ldx    strlens+tempstr
        beq    @b        ;Nothing, so no Y,N,Q script command.
        lda    tempstrloc
        and    #$5F
        cmp    #'Y'
        beq    @b0
        cmp    #'N'
        beq    @b0
        cmp    #'Q'
        beq    @b0        ;Wasn't a Y,N,Q script command.
@b        jsr    rdkey
@b0        and    #$5F
        cmp    #'Y'
        beq    saveit
        cmp    #'N'
        beq    runit
        cmp    #'Q'
        bne    @b

quit        jsr    rtcout
        jsr    MLI
        dc.b    QUIT
        dc.w    @parmTable
@parmTable    dc.b    4
        dc.b    0
        dc.w    0
        dc.b    0
        dc.w    0

runit        jsr    rtcout
        jmp    $2000

saveit        jsr    rtcout
        _var    filetype
        jsr    getint
        bcc    @ok7
        jsr    crEOFMessage
        _write    'filetype.'
        jmp    abort

@ok7        _var    auxtype
        jsr    getint
        bcc    @ok8
        jsr    crEOFMessage
        _write    'auxtype.'
        jmp    abort

@ok8        _writecr            ;Go ahead and save it.
        _var    filestr
        jsr    getstr
        bcc    @ok9
        jsr    crEOFMessage
        _write    'application filename.'
        jmp    abort

@ok9        _write    13,'Saving application as '
        _prstr
        lda    intspace+applen
        sta    @len
        lda    intspace+applen+1
        sta    @len+1
        jsr    saveFile
        dc.w    $2000
@len        dc.w    $FFFF
        bcc @a
        _write    13,13,'Could not save '
        _prstr    filestr
        _write    '.'
        jmp    abort

@a        jsr    getFileInfo    ;Update filetype and auxtype.
        bcc    @b
        _write    13,13,'Could not get file info for '
        _prstr    filestr
        _write    '.'
        jmp    abort

@b        jsr    getToSet        ;Move getInfo data to setInfo block.
        lda    intspace+filetype    ;Set filetype and auxtype.
        sta    setFileInfoBlock+setInfo_filetype
        lda    intspace+auxtype
        sta    setFileInfoBlock+setInfo_auxtype
        jsr    setFileInfo
        bcc    @c
        _write    13,13,'Could not set file info for '
        _prstr    filestr
        _write    '.'
        jmp    abort

@c        jmp    $2000        ;Launch application.


noLoad        _write    13,13,'Could not load '
        _prstr    filestr
        _write    '.'

abort        _write    13,'Please fix and press any key to rebuild ',\
            '(or Q to quit). '
        jsr    rdkey
        and    #$5F
        cmp    #'Q'
        bne    @a
        jmp    quit
@a        jmp    restart


getstr        txa
        pha
        jsr    fillbffrstr
        pla
        tax
        bcs    @rts
@ok        _strcpy    ,bffrstr
        lda    #0
        sta    strlens+bffrstr
        clc
@rts        rts


getint        stx    @xreg
        jsr    fillbffrstr    ;Make sure we have something to chew.
        bcs    @exit        ;If we don't, return an error.

        _strval    bffrstr        ;Get the value of the string and
        ldx    @xreg        ;put it in the variable.
        _set
        _var    bffrstr
        ldy    #0
        sty    decimalint
@a        tya            ;First skip over -'s.
        _strchr
        iny
        cmp    #'-'
        beq    @a
        cmp    #'$'
        beq    @b
        dec    decimalint    ;It was a decimal integer.
@b        ldy    strvalcount
@c        tya
        cmp    strlens,x
        bcs    @d        ;Ran out of string.
        _strchr
        iny
        cmp    #','
        bne    @c
        tya
@d        _midstrcpy ,bffrstr
        clc            ;All went well.
@exit        ldx    @xreg        ;Restore x-reg.
        rts            ;All done
@xreg        dc.b    0
decimalint    dc.b    0


fillbffrstr    lda    strlens+bffrstr    ;See if there is any string left.
        beq    @a        ;There is not, so get another.
        clc
        rts            ;There is, so munch away.
@a        _readstr    bffrstr        ;Read in the next.
        jsr    stripComment    ;Chew off comments -- (who needs them?)
        lda    strlens+bffrstr    ;How did we do?
        beq    @a        ;Empty line -- try again.
        lda    bffrstrloc    ;Check for eof marker.
        cmp    #255
        rts            ;Return carry set if eof hit.


stripComment    txa
        pha
        asl    a
        tax
        lda    strlocs,x    ;Point to the string.
        sta    ptr
        lda    strlocs+1,x
        sta    ptr+1
        pla
        tax
        ldy    #0
@a        tya
        cmp    strlens,x
        beq    @b        ;Hit end-of-string.
        lda    (ptr),y
        iny
        cmp    #';'
        bne    @a        ;Not at comment yet.
        dey

@b        dey            ;Remove all trailing white-space.
        bpl    @c        ;Still some characters left.
        lda    #0
        sta    strlens,x    ;Ran out of string.
        rts

@c        lda    (ptr),y        ;See if it white-space.
        cmp    #9
        beq    @b        ;If it is, keep backing up.
        cmp    #' '
        beq    @b
        iny            ;We ran into something solid.
        tya
        sta    strlens,x

@noComment    rts

crEOFMessage    _writecr
EOFMessage    _write 'Build script EOF hit while reading '
        rts

prepGSBUG    lda    intspace+address+1
        cmp    #$08
        bcc    @bad
        cmp    #$C0-4-1        ;Save space for GSBUG work area and $BF page.
        bcs    @bad
        lda    intspace+address
        beq    @good
@bad        _write    'Bad GSBUG workspace address ('
        _var    address
        lda    decimalint
        bne    @bada
        _write    '$'
        _vhexout
        jmp    @badb
@bada        _vdecout
@badb        _write    ').'
        jmp    abort

@good        clc            ;Turn 16-bit on.
        xce
        rep    #$30
        longi    on
        longa    on

        php            ;We don't want others playing
        sei            ;memory games during this.

        pha
        pha
        pea    $0800>>16
        pea    $0800
        _FindHandle
        pla
        sta    ptr        ;It is actually a handle.
        pla
        sta    ptr+2

        ldy    #4        ;Get handle info for RAM block that
        lda    [ptr],y        ;GS/OS creates to protect primary
        sta    attr        ;memory space.
        iny
        iny
        lda    [ptr],y
        sta    userID

        ldx    #0
        phx
        phx
        pei    ptr+2        ;We want to resize and change the
        pei    ptr        ;handle, so purge it first.
        _SetHandleSize

        lda    #$C000-$0400    ;Calculate new size for handle.
        sec
        sbc    intspace+address
        ldx    #0
        phx
        pha            ;New size now pushed.
        pei    userID
        pei    attr
        phx
        lda    intspace+address
        clc
        adc    #$0400
        pha            ;New location in memory now pushed.
        pei    ptr+2
        pei    ptr
        _ReAllocHandle

        lda    intspace+address
        sec
        sbc    #$0800
        beq    @done        ;We don't need a second handle.
        pha
        pha
        ldx    #0
        phx
        pha            ;Block size now pushed.
        pei    userID
        pei    attr
        phx
        pea    $0800
        _NewHandle
        pla
        pla

@done        plp            ;Restore interrupts.
        sec            ;Turn 8-bit back on.
        xce
        longi    off
        longa    off
        jmp    mainloop


*********************************************


createFile    jsr    MLI
        dc.b    CREATE
        dc.w    createBlock
        rts
createBlock    dc.b    7
        dc.w    fileName
        dc.b    $C3
        dc.b    $06
        dc.w    $2000
        dc.b    $01
        dc.w    $00
        dc.w    $00


setFileInfo    jsr    MLI
        dc.b    SETFILEINFO
        dc.w    setFileInfoBlock
        rts
setFileInfoBlock    dc.b    7
        dc.w    fileName
        dc.b    0
        dc.b    0
        dc.w    0
        ds.b     3
        dc.w    0
        dc.w    0


getFileInfo    jsr    MLI
        dc.b    GETFILEINFO
        dc.w    getFileInfoBlock
        rts
getFileInfoBlock    dc.b    10
        dc.w    fileName
        dc.b    0
        dc.b    0
        dc.w    0
        ds.b    1
        dc.w    1
        dc.w    0
        dc.w    0
        dc.w    0
        dc.w    0


getToSet        ldy    #13-1
@a        lda    getFileInfoBlock+getInfo_pathname,y
        sta    setFileInfoBlock+getInfo_pathname,y
        dey
        bpl    @a
        rts


openFile        jsr    MLI
        dc.b    OPEN
        dc.w    openBlock
        ldx    openBlock+open_refnum
        stx    readBlock+read_refnum
        stx    writeBlock+write_refnum
        stx    setEOFBlock+setEOF_refnum
        stx    closeBlock+close_refnum
        rts
openBlock    dc.b    3
        dc.w    fileName
        dc.w    $BF00-1024
        dc.b    1


readFile        jsr    MLI
        dc.b    READ
        dc.w    readBlock
        rts
readBlock    dc.b    4
        dc.b    1
        dc.w    $2000
        dc.w    $2000
        dc.w    0


writeFile    jsr    MLI
        dc.b    WRITE
        dc.w    writeBlock
        rts
writeBlock    dc.b    4
        dc.b    1
        dc.w    $2000
        dc.w    $2000
        dc.w    0


setEOF        jsr    MLI
        dc.b    SETEOF
        dc.w    setEOFBlock
        rts
setEOFBlock    dc.b    2
        dc.b    1
        ds.b    3


closeFile    jsr    MLI
        dc.b    CLOSE
        dc.w    closeBlock
        rts
closeBlock    dc.b    1
        dc.b    1


loadFile        pla            ;Set ptr to point to params.
        sta    ptr
        pla
        sta    ptr+1
        jsr    prepFile        ;Get all data ready.
        lda    ptr+1        ;Restore return address.
        pha
        lda    ptr
        pha
        jsr    openFile        ;Try opening the file.
        bcs    @rts        ;Bad news...
        jsr    readFile        ;Try reading the file.
        bcc    @a        ;Good news.
        php            ;Read failed -- try closing the
        pha            ;file and restoring the error
        jsr    closeFile    ;to the read error status.
        pla
        plp
        rts
@a        jsr    closeFile    ;Return result of close.
@rts        rts


saveFile        pla            ;Set ptr to point to params.
        sta    ptr
        pla
        sta    ptr+1
        jsr    prepFile        ;Get all data ready.
        lda    ptr+1        ;Restore return address.
        pha
        lda    ptr
        pha
        jsr    createFile    ;Try creating file.
        bcc    @a        ;There was no such file.
        cmp    #$47        ;Make sure error is duplicate file error.
        sec
        bne    @rts

@a        jsr    openFile        ;Try opening the file.
        bcs    @rts        ;Bad news...

        jsr    writeFile    ;Try writing the file.
        bcc    @b        ;Good news.
        php            ;Write failed -- try closing the
        pha            ;file and restoring the error
        jsr    closeFile    ;to the write error status.
        pla
        plp
        rts

@b        lda    writeBlock+write_reqcount
        sta    setEOFBlock+setEOF_EOF
        lda    writeBlock+write_reqcount+1
        sta    setEOFBlock+setEOF_EOF+1
        lda    #0
        sta    setEOFBlock+setEOF_EOF+2
        jsr    setEOF
        bcc    @c
        php
        pha
        jsr    closeFile
        pla
        plp
        rts

@c        jsr    closeFile    ;Return result of close.
@rts        rts


prepFile        lda    strlens+filestr
        sta    fileName        ;Length of string.
        ldy    #1
        lda    (ptr),y
        sta    readBlock+read_databuffer
        sta    writeBlock+write_databuffer
        iny
        lda    (ptr),y
        sta    readBlock+read_databuffer+1
        sta    writeBlock+write_databuffer+1
        iny
        lda    (ptr),y
        sta    readBlock+read_reqcount
        sta    writeBlock+write_reqcount
        iny
        lda    (ptr),y
        sta    readBlock+read_reqcount+1
        sta    writeBlock+write_reqcount+1
        tya
        clc
        adc    ptr
        sta    ptr
        bcc    @d
        inc    ptr+1
@d        rts

        endp

        END